#
# This is a PERL source file of validation routines and help texts for
# the PERSONS databas of the Linux Counter.
#

package Validate::Persons;

use Validate;
use Validate::Common;
use Validate::Places;

@ISA = qw(Validate);

%help = (
name => "Your name",
city => "City where you live",
state => "State or county. Use only in US, CA, AU and GB - see list",
country => "Country where you live. Use the 2-character ISO country code like GB or US",
email => "Your Internet E-mail address",
usage => "Place where you use Linux. Home, work or school",
started => "When you first started using Linux. Format is 'month year' - month names are in English",
"may_publish" => "YES if you wish info you register in the Linux Counter to be available to anyone who wants it. NO otherwise.",
);

sub help {
   my ($self, $field) = @_;

   return $help{$field};
}

sub check {
   my ($self, $field, $value) = @_;

   if ($field eq "name") {
       if ($value eq "") {
	   return "You cannot leave the name field blank!"
       }
   }
   ""; # If we get here - no error
}

sub cleanfield {
    my($self, $field, $value) = @_;
    my($lower, $origval);

    $origval = $value;
    # Generic fieldstripping: Strip quotes and trailing punctuation
    if ($value =~ /^\s*"(.*)"\s*$/) {
	$value = $1;
    }
    $value =~ s/[ \.?]+$//;

    # NOTE: The synonyms book should go here
    my $origvalue = $value; # for those that avoid synonyms
    $value = mapsynonym($field, $value);
    # Tag specific stripping
    # Note - country, city and state need to be worked together
    # using cleanplace, so this is not touched here.
    if ($field eq "may_publish") {
	$value = cleanyesno($value);
    } elsif ($field eq "started") {
	$value = cleanmonthyear($value);
    } elsif ($field eq "usage") {
	$value = cleanusage($value);
    } elsif ($field eq "homepage") {
	$value = cleanurl($value);
    }
    if ($value eq "" && defined($origval) && $origval ne "") {
	$self->notestrange($field, $origval);
    }
    $value;
}

sub clean {
    my ($self, $rec) = @_;
    my $value = {};

    # Make recno accessible for STDERR messages in a module variable
    $current = $rec->key;
    $Validate::Common::current = $rec->key;

    # Backwards compatibility....field has been renamed
    if ($rec->{"may-publish"} && !$rec->{"may_publish"}) {
	$rec->{"may_publish"} = $rec->{"may-publish"};
    }
    for $field (keys(%$rec)) {
	# Skip reserved fields
	if ($field =~ /^[a-z0-9A-Z]/
	    && $field ne "country" && $field ne "state" && $field ne "city") {
	    $$value{$field} = $self->cleanfield($field, $$rec{$field});
	}
    }
    # Clean the place stuff using the places database
    Validate::Places::cleanplace($rec, $value);
    $current = "<norec>";
    return $value;
}

sub notestrange {
    my($self, $field, $value) = @_;
    warn "$current: Strange value: $field $value\n";
}


# UTILITY routines - should move to its own module

sub cleanyesno {
    my $f = shift;

    if (!defined($f)) {
	return "";
    } elsif ($f =~ /^(y|yes|ja)$/i) {
	return "YES";
    } elsif ($f =~ /^(no|n)$/i) {
	return "NO";
    } else {
	return "";
    }
}

sub cleanmonthyear {
    my $f = shift;

    if ($f =~ /^(\S*[^\d\s-])[- ]?(\d+)$/) {
	$month = $1; $year = $2;
	if ($year =~ /^\d\d$/) {
	    if ($year < 90) {
		$year += 2000;
	    } else {
		$year += 1900;
	    }
	}
	# Month name table lookup missing here...
	$month =~ tr/A-Z/a-z/; # match before beauty...
	return "$month $year";
    } else {
	return "";
    }
}

sub cleanusage {

   local($_) = @_;   
   local($vote, $home, $work, $school) = ("", "", "", "");
   if (/ (not|don't) /) { #'
      $vote = "not used";
   } else {
      $home = "home, " if /home/i;
      $work = "work, " if /work/i;
      $school = "school, " if /school/i;
      if (/both/) {
         $home = "home, "; $work = "work, ";
      }
      if (!$home && !$work && !$school) {
         $vote = "somewhere"
      } else {
         $vote = $home . $work . $school;
         chop $vote; chop $vote;
      }
   }
   $vote;
}

sub cleancaps {
    my $val = shift;

    $val = "\L\u$val";   # black magic....lowercase all, upcase first
    $val =~ s/\b./\u$&/g;
    $val;
}

sub cleanurl {
    my $val = shift;

    if ($val =~ /^([a-zA-Z0-9-]+\.)+[a-zA-Z0-9-]+$/) {
	# naked domain name. prefix with http:// and attach trailing slash
	$val = "http://" . $val . "/";
    } elsif ($val =~ /^([a-zA-Z0-9-]+\.)+[a-zA-Z0-9-]+\//) {
	# domain name with suffix. prefix with http://
	$val = "http://" . $val;
    } elsif ($val !~ /^[a-zA-Z0-9]+:/) {
	$val = ""; # no scheme - erroneous - don't show it
    }
    return $val;
}

1;

